Technotools/Technotools (Chestnut CD-ROM)(1993).ISO/lang_pas/mtask11/mtask.pas

Pascal/Delphi Source File | 1988-11-12 | 13KB | 527 lines

UNIT mtask;


{MTASK 1.1, a simple multi-tasker unit for Turbo Pascal 5.

Written in November, 1988, and donated to the public domain by:

   Wayne E. Conrad
   2627 North 51st Ave, #219
   Phoenix, AZ  85035
   BBS: [phone], 300/1200/2400, 24 hours/day

This unit provides Turbo Pascal 5 with what I call "request driven"
multi-tasking.  Switching from the current task to another task is done
whenever the current task requests a task switch by calling procedure
"switch_task."  No interrupt driven context switching is done, because
it's a hassle.

See accompanying files for documentation and examples.}


{$F+}  {Most procedures in this unit must be FAR}


INTERFACE


{The maximum number of tasks.  Modify to suit your needs.}

CONST
  max_tasks = 10;


{Result codes.  0 is "no error"}

CONST
  heap_full       = 1;   {Unable to allocate heap for the task's stack}
  too_many_tasks  = 2;   {Maximum number of tasks are already running}
  invalid_task_id = 3;   {There is no task with that ID number}


{This is the procedure type for a task.  The parent task can pass any
type of variable to pass information to the child task.}

TYPE
  task_proc = PROCEDURE (VAR param);


{A task number is the number used internally by this unit to identify
a task.  It is a direct index into the task_info array.}

TYPE
  task_number = 1..max_tasks;


{A task id is the number used by other units to identify a task.  A
task id is translated into task numbers through the array id_index
(below). }

TYPE
  task_id = 1..max_tasks;


{This record contains all the information about a task, as follows:

  stack_ptr:   Saved stack segment (ss) and stack pointer (sp) registers

  stack_org:   If the stack is stored on the heap, this is the address of
               the beginning of the block of memory allocated for the stack.

  stack_bytes: Size of stack on the heap, or 0 if the stack is not on the
               heap.  If the stack is not on the heap, then this field is 0.

  bp:          Saved value of base pointer (BP) register.

  id:          The id number of the task

Note that DS (Data Segment register) is not stored.  We can get away with
this by assuming that all tasks will use the same data segment.}

TYPE
  task_rec =
    RECORD
    stack_ptr  : Pointer;
    stack_org  : Pointer;
    stack_bytes: Word;
    bp         : Word;
    id         : task_id;
    END;


{This array type is used to store information for each task.}

TYPE
  task_info_array = ARRAY [task_number] OF task_rec;


{See the IMPLEMENTATION section for descriptions of these procedures and
functions.}

PROCEDURE create_task
  (
  task      : task_proc;
  VAR param ;
  stack_size: Word;
  VAR id    : Word;
  VAR result: Word
  );
PROCEDURE terminate_task (id: Word; VAR result: Word);
PROCEDURE switch_task;
FUNCTION current_task_id: task_id;
FUNCTION number_of_tasks: task_number;
PROCEDURE get_task_info
  (
  VAR info: task_info_array;
  VAR n   : task_number
  );


IMPLEMENTATION


{For each task id, this array gives the task number.  When a calling unit
gives a task id, this array is used to convert it into a task number.  If
id_index [id] = 0, then id is unused.  If id_index [id] is not zero, then
it's the task number of the task with that id.}

VAR
  id_index: ARRAY [task_id] OF 0..max_tasks;


{The number of tasks in the system}

VAR
  ntasks: task_number;


{Information for each task.}

VAR
  task_info: task_info_array;


{This is the task number of the currently executing task}

VAR
  current_task: task_number;


{This is the record type of the initial contents of the stack when a task
is created.  When the task is first switched to, it will be from within
the switch_task, terminate_task, or terminate_current_task procedure.
At the end of switch_task, BP will be popped, then a far return
will be done.  The far return will transfer to the beginning
of task.  The task can access the parameter "task_param," which is a pointer to
whatever data structure that the creator of this task wanted to pass to the
new task.  When the task finally exits, a far return to "end_task"
will be done.  The exception is the main task, which ends the program
completely if it exits.}

TYPE
  initial_stack_rec_ptr = ^initial_stack_rec;
  initial_stack_rec =
    RECORD
    bp        : Word;
    task_addr : task_proc;
    end_task  : Pointer;
    task_param: Pointer;
    END;


{Remove a task's information from the task info array, and decrement
the number of tasks.}

PROCEDURE delete_task_info (task_num: task_number);
VAR
  i: task_number;
BEGIN
  FOR i := task_num TO ntasks - 1 DO
    BEGIN
    task_info [i] := task_info [i + 1];
    END;
  Dec (ntasks);
END;


{Terminate the current task.  If the current task is the only task, then
the program is halted.  If the current task's stack was allocated from the
heap, it is freed.}

PROCEDURE terminate_current_task;


{These are defined as constants to force them into the data segment.  They
can't be local, because local variables are stored on the stack and we're
going to switch to a different task before we're done with these variables.}

CONST
  old_stack_org  : Pointer = NIL;
  old_stack_bytes: Word = 0;


VAR
  task_num : task_number;
  new_stack: Pointer;
  new_bp   : Word;


BEGIN

  {If we're the last task left, then exit to DOS}

  IF ntasks <= 1 THEN
    Halt;

  {Free up the task id so that it can be reused when another task is
  created.  Remember where the task's stack is so that we can free it up
  if it's on the heap.  We can't free it now, because we're still using it!}

  WITH task_info [current_task] DO
    BEGIN
    id_index [id]   := 0;
    old_stack_org   := stack_org;
    old_stack_bytes := stack_bytes;
    END;

  {Remove the task's information from the task info array}

  delete_task_info (current_task);
  IF current_task > ntasks THEN
    current_task := 1;

  {Switch to the next task.  The stack_ptr and bp are transfered into local
  variables because it's much easier to access simple variables in
  INLINE code than it is to access array variables.}

  WITH task_info [current_task] DO
    BEGIN
    new_stack := stack_ptr;
    new_bp    := bp;
    END;
  INLINE
    (
    $8b/$86/>new_stack+0/     {MOV  AX,[BP].NEW_STACK+0}
    $8b/$96/>new_stack+2/     {MOV  DX,[BP].NEW_STACK+2}
    $8b/$ae/>new_bp/          {MOV  BP,[BP].NEW_BP}
    $fa/                      {CLI}
    $8e/$d2/                  {MOV  SS,DX}
    $8b/$e0/                  {MOV  SP,AX}
    $fb                       {STI}
    );

  {If the task we just got rid of had its heap on the stack, then release
  that memory back to the free pool.}

  IF old_stack_bytes > 0 THEN
    FreeMem (old_stack_org, old_stack_bytes);
END;


{Terminate a task.  If task_id is 0, then the current task is deleted.
Possible result codes are:

  0                   No error
  invalid_task_id     There is no task with that ID number}

PROCEDURE terminate_task (id: Word; VAR result: Word);


  {Delete a task.  Do not use to delete the current task!}

  PROCEDURE delete_task (task_num: task_number);
  VAr
    i: task_number;
  BEGIN
    id_index [id] := 0;
    WITH task_info [task_num] DO
      IF stack_bytes > 0 THEN
        FreeMem (stack_org, stack_bytes);
    delete_task_info (task_num);
    IF current_task > task_num THEN
      Dec (current_task);
  END;


VAR
  task_num: task_number;

BEGIN {terminate_task}
  result := 0;
  IF id = 0 THEN
    terminate_current_task
  ELSE
    IF (id < 1) OR (id > max_tasks) THEN
      result := invalid_task_id
    ELSE
      BEGIN
      task_num := id_index [id];
      IF task_num = current_task THEN
        terminate_current_task
      ELSE
        IF task_num = 0 THEN
          result := invalid_task_id
        ELSE
          delete_task (task_num);
      END;
END;


{Create a new task and pass parameter "param" to it.  Stack space for
the task is allocated from the heap, and the stack is initialized
so that procedure "new_task" will be executed with parameter "param".
Result codes are:

  0                  No error occured
  heap_full          Unable to allocate heap for the task's stack
  too_many_tasks     Maximum number of tasks are already running

If an error occurs, then id is not set.  Otherwise, id is the task
id of the newly created task.}

PROCEDURE create_task
  (
  task      : task_proc;
  VAR param ;
  stack_size: Word;
  VAR id    : Word;
  VAR result: Word
  );


{This is the task number of the task we're creating}

VAR
  task_num: task_number;


  {Allocate stack space for the task.  The minimum allowable
  requested stack size is 512 bytes.  For some reason, the stack-check
  procedure in Turbo's run-time library has that limit hard-coded into
  it.

  stack_org is set to the address of the beginning of the block of memory
  allocated for the stack.

  stack_bytes is set to the size of the block of memory allocated for the
  stack.}

  PROCEDURE create_stack;
  BEGIN
    IF stack_size < 512 THEN
      stack_size := 512;
    IF stack_size > MaxAvail THEN
      result := heap_full
    ELSE
      WITH task_info [task_num] DO
        BEGIN
        GetMem (stack_org, stack_size);
        stack_bytes := stack_size;
        END;
  END;


  {Initialize the stack and the stack pointer.  The structure
  "initial_stack_rec" is placed at the top of the stack area, with the
  stack pointer pointing to its lowest element.  See the comments
  for initial_stack_rec for what the stuff in initial_stack_rec
  actually does.}

  PROCEDURE init_stack;
  VAR
    stack_ofs: Word;
  BEGIN
    WITH task_info [task_num] DO
      BEGIN
      stack_ofs := Ofs (stack_org^) + stack_bytes - Sizeof (initial_stack_rec);
      stack_ptr := Ptr (Seg (stack_org^), stack_ofs);
      bp := Ofs (stack_ptr^);
      WITH initial_stack_rec_ptr (stack_ptr)^ DO
        BEGIN
        task_param := @param;
        task_addr  := task;
        end_task   := @terminate_current_task;
        bp         := 0;
        END;
      END;
  END;


  {Find an unused task id and assign it to the new task}

  PROCEDURE assign_task_id;
  BEGIN
    id := 1;
    WHILE (id_index [id] <> 0) DO
      Inc (id);
    task_info [task_num].id := id;
    id_index [id] := task_num;
  END;


BEGIN {create_task}
  IF ntasks >= max_tasks THEN
    result := too_many_tasks
  ELSE
    BEGIN
    task_num := Succ (ntasks);
    create_stack;
    IF result = 0 THEN
      BEGIN
      init_stack;
      assign_task_id;
      Inc (ntasks);
      END
    END;
END;


{Switch to the next task}

PROCEDURE switch_task;

VAR
  new_stack: Pointer;
  old_bp   : Word;
  new_bp   : Word;

BEGIN

  {Only switch if there are other tasks to switch to}

  IF ntasks > 1 THEN
    BEGIN

    {Save the current value of SS, SP, and BP for this task}

    INLINE
      (
      $89/$ae/>old_bp           {MOV  OLD_BP,BP}
      );
    WITH task_info [current_task] DO
      BEGIN
      stack_ptr := Ptr (Sseg, Sptr);
      bp        := old_bp;
      END;

    {Switch to the next task.  The bit with new_stack and new_bp are because
    it's easier to write INLINE code to access a simple variable than it is
    to access a record of an array.}

    IF current_task >= ntasks THEN
      current_task := 1
    ELSE
      Inc (current_task);
    WITH task_info [current_task] DO
      BEGIN
      new_stack := stack_ptr;
      new_bp    := bp;
      END;
    INLINE
      (
      $8b/$86/>new_stack+0/     {MOV  AX,[BP].NEW_STACK+0}
      $8b/$96/>new_stack+2/     {MOV  DX,[BP].NEW_STACK+2}
      $8b/$ae/>new_bp/          {MOV  BP,[BP].NEW_BP}
      $Fa/                      {CLI}
      $8e/$d2/                  {MOV  SS,DX}
      $8b/$e0/                  {MOV  SP,AX}
      $fb                       {STI}
      );
    END;
END;


{Return the id number of the currently executing task}

FUNCTION current_task_id: task_id;
BEGIN
  current_task_id := task_info [current_task].id;
END;


{Return the number of tasks}

FUNCTION number_of_tasks: task_number;
BEGIN
  number_of_tasks := ntasks;
END;


{Return a copy of the task info array, as well as the number of tasks.}

PROCEDURE get_task_info
  (
  VAR info: task_info_array;
  VAR n   : task_number
  );
BEGIN
  n    := ntasks;
  info := task_info;
END;


{Initialize this unit.  The task list is initialized to contain the
current task, whose task id is 1.}

PROCEDURE init_mtask;
VAR
  id: task_id;
BEGIN
  FOR id := 1 TO max_tasks DO
    id_index [id] := 0;
  ntasks := 1;
  current_task := 1;
  WITH task_info [current_task] DO
    BEGIN
    stack_org   := NIL;
    stack_bytes := 0;
    id          := 1;
    id_index [id] := current_task;
    END;
END;


BEGIN {mtask}
  init_mtask;
END.